home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol047 / sortdemo.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1987-01-11  |  8.8 KB  |  329 lines
  1. 10  '
  2. 20  '   *****************************************************
  3. 30  '   **   Program using graphics to demonstrate sorts   **
  4. 40  '   **   by Joe Long     Calhoun Community College     **
  5. 50  '   **   Decatur, Alabama           June 19, 1983      **
  6. 60  '   *****************************************************
  7. 70  '
  8. 80  CLS : PRINT "Copyright 1983 by Joe Long" : FOR I = 1 TO 2000 : NEXT I
  9. 82  PRINT "Not for Commercial use." : FOR I = 1 TO 2000 : NEXT I
  10. 85  LOCATE 12,10:PRINT "If you do not have the color graphic's adaptor "
  11. 86  LOCATE 14,10:PRINT "Then you can not enjoy this program. "
  12. 87  LOCATE 16,10:PRINT "Enter the letter ";CHR$(34);"Q";CHR$(34);" to Quit"
  13. 88  LOCATE 17,10,1:PRINT "or press <ENTER> to continue.";
  14. 90  A$=INKEY$:IF A$="" THEN 90 ELSE IF A$="q" OR A$="Q" THEN 9900
  15. 100  '   ***   Initialize progam   ***
  16. 110  '
  17. 120  DEFINT A-Z
  18. 130  KEY OFF : ON KEY (1) GOSUB 1000 : ON KEY (2) GOSUB 2000 : ON KEY (3) GOSUB 3000 : ON KEY (4) GOSUB 4000 : ON KEY (5) GOSUB 5000 : ON KEY (10) GOSUB 9900
  19. 140  KEY (1) ON : KEY (2) ON : KEY (3) ON : KEY (4) ON : KEY (5) ON : KEY (10) ON
  20. 150  RANDOMIZE(VAL(LEFT$(TIME$,2))*1000 + VAL(MID$(TIME$,3,2))*100 + VAL(RIGHT$(TIME$,2)))
  21. 160  DIM N(40)
  22. 165  DIM TIME.MEM#(5)
  23. 190  '
  24. 200  '   ***   Main Menu Routines   ***
  25. 210  '
  26. 220  IF TMP.TIME#>0 THEN TIME.MEM#(F.KEY)=ABS(TMP.TIME#-(VAL(RIGHT$(TIME$,2))+VAL(MID$(TIME$,4,2))*60))
  27. 221  SCREEN 0,1,0,0 : WIDTH 80 : COLOR 3,0,0 : CLS
  28. 230  PRINT TAB(32) "Sorting Technique"
  29. 240  PRINT : PRINT TAB(20) "Type of Sort"; TAB(60) "Function Key"
  30. 250  PRINT "SECONDS  ";TAB(20) "------------"; TAB(60) "------------"
  31. 260  PRINT : PRINT TIME.MEM#(1); TAB(20) "Bubble Sort"; TAB(65) "F1"
  32. 270  PRINT : PRINT TIME.MEM#(2);TAB(20) "Delayed Replacement Sort"; TAB(65) "F2"
  33. 280  PRINT : PRINT TIME.MEM#(3);  TAB(20) "Insertion Sort"; TAB(65) "F3"
  34. 290  PRINT : PRINT TIME.MEM#(4); TAB(20) "Shell-Metzner Sort"; TAB(65) "F4"
  35. 300  PRINT :PRINT TIME.MEM#(5); TAB(20) "Quicksort"; TAB(65) "F5"
  36. 310  PRINT : PRINT TAB(20) "Exit Program"; TAB(65) "F10"
  37. 320  PRINT : PRINT TAB(30) "Press Function key for choice."
  38. 330  Q$ = INKEY$ : GOTO 330
  39. 990  '
  40. 1000  F.KEY=1' ***   Bubble Sort Demo   ***
  41. 1010  '
  42. 1100  GOSUB 9200   '   prepare random # array
  43. 1110  GOSUB 6000   '   set up display
  44. 1190  '
  45. 1200  '   **   Sort array   **
  46. 1210  '
  47. 1220  FOR I = 40 TO 2 STEP -1
  48. 1230    FOR J = 1 TO I-1
  49. 1240      P1 = J : P2 = J+1   '   ID points being compared for graphics subr.
  50. 1250      GOSUB 6200          '   Highlight points being compared
  51. 1260      IF N(J+1) > N(J) THEN 1310
  52. 1270      TEMP = N(J+1)       '   Swap values
  53. 1280      N(J+1) = N(J)
  54. 1290      N(J) = TEMP
  55. 1300      GOSUB 6400          '   Plot swapped points
  56. 1310      Q$ = INKEY$ : IF Q$ <> "" THEN IF ASC(Q$) = 27 THEN RETURN 220
  57. 1320    NEXT J
  58. 1330  NEXT I
  59. 1340  'FOR DELAY = 1 TO 2000 : NEXT DELAY
  60. 1350  RETURN 220
  61. 1990  '
  62. 2000  F.KEY=2' ***   Delayed Replacement Sort Demo   ***
  63. 2010  '
  64. 2100  GOSUB 9200   '   prepare random # array
  65. 2110  GOSUB 6000   '   set up display
  66. 2190  '
  67. 2200  '   **   Sort array   **
  68. 2210  '
  69. 2220  FOR I = 40 TO 2 STEP -1
  70. 2230    TRIAL = 1              '   Starting location for compare
  71. 2240    FOR J = 1 TO I
  72. 2250      P1 = TRIAL : P2 = J
  73. 2260      GOSUB 6200           '   Highlight compare
  74. 2270      IF N(J) > N(TRIAL) THEN TRIAL = J    '  Find biggest value
  75. 2280      Q$ = INKEY$ : IF Q$ <> "" THEN IF ASC(Q$) = 27 THEN RETURN 220
  76. 2290    NEXT J
  77. 2300    TEMP = N(I)   '   Swap values
  78. 2310    N(I) = N(TRIAL)
  79. 2320    N(TRIAL) = TEMP
  80. 2330    P1 = TRIAL : P2 = I
  81. 2340    GOSUB 6400   '   Highlight swap
  82. 2350  NEXT I
  83. 2360  'FOR DELAY = 1 TO 2000 : NEXT DELAY
  84. 2370  RETURN 220
  85. 2990  '
  86. 3000  F.KEY=3' ***   Insertion Sort Demo   ***
  87. 3010  '
  88. 3100  GOSUB 9200   '   prepare random # array
  89. 3110  GOSUB 6000   '   set up display
  90. 3190  '
  91. 3200  '   **   Sort array   **
  92. 3210  '
  93. 3220  FOR I = 2 TO 40
  94. 3230    FOR J = I-1 TO 1 STEP -1   '   Find location for number
  95. 3240      Q$ = INKEY$ : IF Q$ <> "" THEN IF ASC(Q$) = 27 THEN RETURN 220
  96. 3250      P1 = I : P2 = J
  97. 3260      GOSUB 6200                 '   Highlight compare
  98. 3270      IF N(I) > N(J) THEN 3290   '   Slot found
  99. 3280    NEXT J
  100. 3290    J = J + 1    '   Adjust J value
  101. 3300    TEMP = N(I)  '   Hold number
  102. 3310    P2 = J
  103. 3320    GOSUB 6700
  104. 3330    FOR K = I TO J+1 STEP -1  '   Bump everybody up one slot
  105. 3340      N(K) = N(K-1)
  106. 3350      P1 = K - 1
  107. 3360      GOSUB 6800
  108. 3365      FOR DELAY = 1 TO 20 : NEXT DELAY
  109. 3370    NEXT K
  110. 3380    N(J) = TEMP               '   Insert number
  111. 3390    GOSUB 6900
  112. 3400  NEXT I
  113. 3410  'FOR DELAY = 1 TO 2000 : NEXT DELAY
  114. 3420  RETURN 220
  115. 3990  '
  116. 4000  F.KEY=4' ***   Shell-Metzner Sort Demo   ***
  117. 4010  '
  118. 4100  GOSUB 9200   '   prepare random # array
  119. 4110  GOSUB 6000   '   set up display
  120. 4190  '
  121. 4200  '   **   Sort array   **
  122. 4210  '
  123. 4220  M = 40 : N = 40   '   Array size
  124. 4230  M = INT(M/2)      '   Divide array
  125. 4240  WHILE M > 0
  126. 4250    K = N-M
  127. 4260    J = 1
  128. 4270    I = J
  129. 4280    L = I + M
  130. 4290    P1 = L : P2 = I
  131. 4300    GOSUB 6200      '   Highlight compare
  132. 4310    Q$ = INKEY$ : IF Q$ <> "" THEN IF ASC(Q$) = 27 THEN RETURN 220
  133. 4320    IF N(L) > N(I) THEN 4390
  134. 4330    TEMP = N(I)   '   Swap values
  135. 4340    N(I) = N(L)
  136. 4350    N(L) = TEMP
  137. 4360    GOSUB 6400    '   Highlight swap
  138. 4370    I = I - M
  139. 4380    IF I > 0 THEN 4280
  140. 4390    J = J + 1
  141. 4400    IF J > K THEN 4230 ELSE 4270
  142. 4410  WEND
  143. 4420  'FOR DELAY = 1 TO 2000 : NEXT DELAY
  144. 4430  RETURN 220
  145. 4910  '
  146. 5000  F.KEY=5:BEEP ' ***   Quicksort Demo   ***
  147. 5010  '
  148. 5100  GOSUB 9200   '   prepare random # array
  149. 5110  GOSUB 6000   '   set up display
  150. 5190  '
  151. 5200  '   **   Sort array   **
  152. 5210  '
  153. 5220  D = 0 : L = 1 : R = 40   '   Initialize variables
  154. 5230  IF L >= R THEN 5320
  155. 5240  GOSUB 5400
  156. 5250  Q$ = INKEY$ : IF Q$ <> "" THEN IF ASC(Q$) = 27 THEN RETURN 220
  157. 5260  IF R1-L < L-R1 THEN 5300   '   Do smaller subarray first
  158. 5270  GOSUB 5800
  159. 5280  GOSUB 5850
  160. 5290  GOTO 5320
  161. 5300  GOSUB 5850
  162. 5310  GOSUB 5800
  163. 5320  IF D = 0 THEN 5370       '    Done
  164. 5330  L = L(D)
  165. 5340  R = R(D)
  166. 5350  D = D - 1
  167. 5360  GOTO 5230
  168. 5370  'FOR DELAY = 1 TO 2000 : NEXT DELAY
  169. 5380  RETURN 220
  170. 5390  '
  171. 5400  '   **   Partition array   **
  172. 5410  '
  173. 5420  V = N(L)
  174. 5430  L1 = L + 1
  175. 5440  R1 = R
  176. 5450  FOR I = L1 TO R
  177. 5460    P1 = L : P2 = I
  178. 5470    GOSUB 6200
  179. 5490    IF N(I) > V THEN 5510
  180. 5500  NEXT I
  181. 5510  L1 = I
  182. 5520  FOR J = R1 TO L + 1 STEP -1
  183. 5530    P1 = L : P2 = J
  184. 5540    GOSUB 6200
  185. 5550    IF N(J)<V THEN 5580
  186. 5560  NEXT J
  187. 5580  R1 = J
  188. 5590  IF L1>R1 THEN 5680
  189. 5600  P1 = L1 : P2 = R1
  190. 5610  TEMP = N(L1)
  191. 5620  N(L1) = N(R1)
  192. 5630  N(R1) = TEMP
  193. 5640  GOSUB 6400
  194. 5660  GOTO 5450
  195. 5680  N(L) = N(R1)        '   Put partition value in place
  196. 5690  N(R1) = V
  197. 5700  P1 = L : P2 = R1
  198. 5710  GOSUB 6400
  199. 5720  RETURN
  200. 5800  '   **   Load left sub-array   **
  201. 5810  D = D + 1
  202. 5820  L(D) = L
  203. 5830  R(D) = R1 - 1
  204. 5840  RETURN
  205. 5850  '   **   Load right sub-array   **
  206. 5860  D = D + 1
  207. 5870  L(D) = R1 + 1
  208. 5880  R(D) = R
  209. 5890  RETURN
  210. 5990  '
  211. 6000  ' ***   Graphics Routines   ***
  212. 6010  '
  213. 6020  CLS : SCREEN 1,0 : COLOR 1,0
  214. 6030  BLOCK(0) = 16 : BLOCK(1) = 3  '  Define shape of block for PUT statement
  215. 6040  FOR I = 2 TO 4 : BLOCK(I) = -21846 : NEXT I
  216. 6050  BLOCKSWAP(0) = 16 : BLOCKSWAP(1) = 3  '   Define block for swapping
  217. 6060  FOR I = 2 TO 4 : BLOCKSWAP(I) = -1 : NEXT I
  218. 6070  BACKGROUND(0) = 16 : BACKGROUND(1) = 3  '  Define block for erasing
  219. 6080  FOR I = 2 TO 4 : BACKGROUND(I) = 0 : NEXT I
  220. 6085  TMP.TIME#=VAL(RIGHT$(TIME$,2))+VAL(MID$(TIME$,4,2))*60
  221. 6090  '
  222. 6100  '   **   Put random # array on screen   **
  223. 6110  '
  224. 6120  FOR I = 1 TO 40
  225. 6130    X = 8*(I-1)
  226. 6140    Y = 124-3*N(I)
  227. 6150    PUT (X,Y), BLOCK, PSET
  228. 6160  NEXT I
  229. 6170  LOCATE 22,6 : PRINT "Press <Esc> to return to menu"
  230. 6180  RETURN
  231. 6190  '
  232. 6200  '   **   Highlight points being compared   **
  233. 6210  '
  234. 6220  X = 8*(P1-1)
  235. 6230  Y = 124-3*N(P1)
  236. 6240  X1 = 8*(P2-1)
  237. 6250  Y1 = 124-3*N(P2)
  238. 6260  PUT (X,Y), BLOCK, PRESET
  239. 6270  PUT (X1,Y1), BLOCK, PRESET
  240. 6280  LOCATE 20,15 : PRINT "COMPARING . . .    "
  241. 6290  FOR DELAY = 1 TO 200 : NEXT DELAY
  242. 6300  PUT (X,Y), BLOCK, PSET
  243. 6310  PUT (X1,Y1), BLOCK, PSET
  244. 6320  LOCATE 20,15 : PRINT SPACE$(34)
  245. 6380  RETURN
  246. 6390  '
  247. 6400  '   **   Highlight swapped points   **
  248. 6410  '
  249. 6420  X = 8*(P1-1)
  250. 6430  Y = 124-3*N(P1)
  251. 6440  X1 = 8*(P2-1)
  252. 6450  Y1 = 124-3*N(P2)
  253. 6460  PUT (X,Y1), BLOCKSWAP, PSET
  254. 6470  PUT (X1,Y), BLOCKSWAP, PSET
  255. 6480  LOCATE 18,P1 : PRINT "^"; : LOCATE 18,P2 : PRINT "^"
  256. 6490  LOCATE 19,P1 : PRINT "|"; : LOCATE 19,P2 : PRINT "|"
  257. 6500  LOCATE 20,15 : PRINT "SWAPPING . . .     "
  258. 6510  FOR DELAY = 1 TO 500 : NEXT DELAY
  259. 6520  PUT (X,Y1), BACKGROUND, PSET
  260. 6530  PUT (X1,Y), BACKGROUND, PSET
  261. 6540  PUT (X,Y), BLOCKSWAP, PSET
  262. 6550  PUT (X1,Y1), BLOCKSWAP, PSET
  263. 6560  FOR DELAY = 1 TO 300 : NEXT DELAY
  264. 6570  PUT (X,Y), BLOCK, PSET
  265. 6580  PUT (X1,Y1), BLOCK, PSET
  266. 6590  LOCATE 18,1 : PRINT SPACE$(40);
  267. 6600  LOCATE 19,1 : PRINT SPACE$(40);
  268. 6610  LOCATE 20,15 : PRINT SPACE$(34);
  269. 6620  RETURN
  270. 6690  '
  271. 6700  '   **   Highlight point to be inserted   **
  272. 6710  '
  273. 6720  X = 8*(P1-1)
  274. 6730  Y = 124-3*N(P1)
  275. 6740  X1 = 8*(P2-1)
  276. 6750  PUT (X,Y), BACKGROUND, PSET
  277. 6760  PUT (X1,Y), BLOCKSWAP, PSET
  278. 6770  RETURN
  279. 6790  '
  280. 6800  '   **   Bump points up for insertion   **
  281. 6810  '
  282. 6820  X = 8*(P1-1) : Y = 124-3*N(P1)
  283. 6830  PUT (X+8,Y), BACKGROUND, PSET
  284. 6840  PUT (X,Y), BLOCKSWAP, PSET
  285. 6850  LOCATE 20,15 : PRINT "Bumping . . .    "
  286. 6860  PUT (X+8,Y), BLOCKSWAP, PSET
  287. 6870  PUT (X,Y), BACKGROUND, PSET
  288. 6880  PUT (X+8,Y), BLOCK, PSET : RETURN
  289. 6890  '
  290. 6900  '   **   Insert point   **
  291. 6910  '
  292. 6920  LOCATE 20,15 : PRINT "Insert . . .      "
  293. 6930  X = 8*(I-1) : Y = 124-3*N(P1)
  294. 6940  X1 = 8*(P2-1)
  295. 6950  PUT (X,Y), BACKGROUND, PSET
  296. 6960  PUT (X1,Y), BLOCK, PSET
  297. 6970  RETURN
  298. 6990  '
  299. 8990  '
  300. 9000  '   ***   Miscellaneous Subroutines   ***
  301. 9010  '
  302. 9100  '   **  Process Yes/No Inputs  **
  303. 9110  '
  304. 9120  Q$ = ""
  305. 9130  WHILE Q$ = "" : WEND
  306. 9140  IF Q$ <> "Y" AND Q$ <> "y" AND Q$ <> "N" AND Q$ <> "n" THEN BEEP : GOTO 9120
  307. 9150  IF Q$ = "Y" OR Q$ = "y" THEN YES = 1 ELSE YES = 0
  308. 9160  IF YES = 1 THEN PRINT "Yes" ELSE PRINT "No"
  309. 9170  RETURN
  310. 9190  '
  311. 9200  '   **  Fill array with random numbers  **
  312. 9210  '
  313. 9220  FOR I = 1 TO 40    '   Fill array with ordered numbers
  314. 9230    N(I) = I
  315. 9240  NEXT I
  316. 9250  FOR I = 40 TO 2 STEP -1   '   Scramble array
  317. 9260    EXCHANGE = INT(RND*(I)+1)
  318. 9270    TEMP = N(I)
  319. 9280    N(I) = N(EXCHANGE)
  320. 9290    N(EXCHANGE) = TEMP
  321. 9300  NEXT I
  322. 9310  RETURN
  323. 9890  '
  324. 9900  '   **   End of program routine   **
  325. 9910  '
  326. 9920  SCREEN 0,1,0 : COLOR 6,0,0 : CLS
  327. 9930  'Program uploaded to CPCUG on 26 July by Joe Long Madison AL.
  328. 9940  END
  329.